home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / secure12.arc / SECURE12.BAS (.txt) next >
Encoding:
GW-BASIC  |  1984-09-28  |  8.5 KB  |  286 lines
  1. 100  '       Written for RBBS-PC VER 12.2 (03-23-84)
  2. 110  '       Kent Galbraith Sysop Kingcomm RBBS-PC Kingwood Texas
  3. 120  '       713-360-1316 Data
  4. 130  '
  5. 140  CLEAR 5000:DEFINT X,Y,Z:DIM X,Y,Z
  6. 150  '
  7. 160  ON ERROR GOTO  2730: KEY OFF
  8. 170  '
  9. 180  '
  10. 190  '
  11. 200   REM . . . . --->  Program Name is  SECURE.BAS <-----
  12. 210   V1$= "SECURE"'  Master File Name
  13. 220   V2$= "SECURE.ISI"'  Key File Name
  14. 230   RL% =  30 '  Record Length
  15. 240   KL% =  13 '  Key Length
  16. 250   T =  3 '  Total Number of Fields
  17. 260   HOME$ = CHR$( 11)
  18. 270   SUBKEY%= INT(64/(KL%+6))
  19. 280   BOTT$ = HOME$+STRING$(0, 28)+STRING$( 22, 31)
  20. 290   BLANK$= STRING$( 75,32)
  21. 300   CL$ = CHR$( 11)+CHR$( 12)+CHR$( 11)
  22. 310   RC =  28
  23. 320   DC =  31
  24. 330   RB$= CHR$(32)+CHR$(29)
  25. 340   SB$= CHR$(219)+CHR$(29)
  26. 350   BS$= CHR$( 28)+CHR$(29)+CHR$(29)+CHR$(32)+CHR$(29)
  27. 360   FF$ = CHR$( 140 )
  28. 370  DIM F$(T),F#(T)' Dimension Fields
  29. 380  DEF FN CRT$(E1,E2)=HOME$+STRING$(E2,DC)+STRING$(E1,RC)
  30. 390  '
  31. 400  D$=CHR$(94)+STRING$(KL%,32):'  Dummy Key
  32. 410  DIM CX(3),CY(3),FL(3),TY$(3)
  33. 420  A%=INT(64/(KL%+6))'           Number of Keys per Sector
  34. 430  '
  35. 440  OPEN "R",1,V1$,RL%:'           Open Master File
  36. 450  OPEN "R",2,V2$,64:'            Open Key File
  37. 460  FIELD 1,RL% AS FR$:'           Field Master File Buffer
  38. 470  FIELD 2,32 AS KS$:'            Field Key File Buffer
  39. 480  PRINT CL$;
  40. 490  FL(1)=13:CX(1)=47:CY(1)=6:TY$(1)="A"
  41. 500  FL(2)=3:CX(2)=47:CY(2)=8:TY$(2)="N"
  42. 510  FL(3)=9:CX(3)=47:CY(3)=10:TY$(3)="A"
  43. 520  PRINT HOME$;'  Print Screen
  44. 530   PRINT "                 WRITTEN FOR RBBS-PC VER.12.2"
  45. 540   PRINT ""
  46. 550   PRINT "                 by Kent Galbraith Sysop Kingcomm RBBS-PC"
  47. 560   PRINT ""
  48. 570   PRINT "                    Kingwood Texas,77051,713-360-1316"
  49. 580   PRINT ""
  50. 590   PRINT "      ENTER FILENAME AND EXT                  :............."
  51. 600   PRINT ""
  52. 610   PRINT "      ENTER SECURITY CODE NUMBER 1-99         :..."
  53. 620   PRINT ""
  54. 630   PRINT "      ENTER OPTIONAL PASSWORD 8 CHARS MAX     :........."
  55. 640   PRINT ""
  56. 650   PRINT ""
  57. 660   PRINT ""
  58. 670   PRINT ""
  59. 680   PRINT ""
  60. 690   PRINT ""
  61. 700   PRINT "      THIS PROGRAM CAN ALSO BE USED FOR THE GROUP FILE"
  62. 710   PRINT ""
  63. 720   PRINT ""
  64. 730   PRINT ""
  65. 740   PRINT ""
  66. 750  '
  67. 760  '  Begin Mainline of Program (03-24-84)
  68. 770  '
  69. 780  UPDTE$=""
  70. 790  FOR X = 1 TO T:F$(X)="":F#(X)=0: NEXT X' Clear  Fields
  71. 800  PRINT BOTT$;BLANK$;BOTT$;"<A>dd Record, <G>et Record, <S>earch or <E>nd Program ";
  72. 810  TY$="A":FL=1
  73. 820  GOSUB 2370
  74. 830     IF T$="A"  OR T$="a" THEN 900
  75. 840     IF T$="G"  OR T$="g" THEN UPDTE$="YES":GOTO  1880
  76. 850     IF T$="E"  OR T$="e" THEN 2670
  77. 860     IF T$="S"  OR T$="s" THEN 1690
  78. 870  PRINT CHR$(7);
  79. 880  GOTO  800
  80. 890  '
  81. 900  '        Start of Input
  82. 910  '
  83. 920  PRINT BOTT$;BLANK$;BOTT$;"Enter the < Key to back up a Field";
  84. 930  '
  85. 940  'Field No.  1  IS FILENAME / Length -  13  / Type - A
  86. 950  '
  87. 960  PRINT FN CRT$( 47 , 6 );"";
  88. 970  FL =  13 
  89. 980  TY$ = "A"
  90. 990  GOSUB 2370
  91. 1000  IF LEN(T$)=0 THEN  1030 
  92. 1010  IF ASC(T$)=60 THEN 520
  93. 1020  F$( 1 ) = T$ : REM MOVE INKEY VARIABLE TO FIELD 
  94. 1030  F$( 1 ) = F$( 1 ) + STRING$( 13 -LEN(F$( 1 )),32)
  95. 1040  PRINT FN CRT$( 47 , 6 );F$( 1 );
  96. 1050  K$= F$( 1 )
  97. 1060  '
  98. 1070  '
  99. 1080  'Field No.  2  IS SECURITY CODE / Length -  3  / Type - N
  100. 1090  '
  101. 1100  PRINT FN CRT$( 47 , 8 );"";
  102. 1110  FL =  3 
  103. 1120  TY$ = "N"
  104. 1130  GOSUB 2370
  105. 1140  IF LEN(T$)=0 THEN  1190 
  106. 1150  IF ASC(T$)=60 THEN  940 
  107. 1160  GOSUB 2540: REM .. NUMERIC CHECK SUB ROUTINE ...
  108. 1170  IF N=0 THEN PRINT CHR$(7);:GOTO  1080 
  109. 1180  F$( 2 ) = T$ : REM MOVE INKEY VARIABLE TO FIELD 
  110. 1190  F$( 2 ) = F$( 2 ) + STRING$( 3 -LEN(F$( 2 )),32)
  111. 1200  PRINT FN CRT$( 47 , 8 );F$( 2 );
  112. 1210   F#( 2 ) = VAL(F$( 2 ))
  113. 1220  '
  114. 1230  '
  115. 1240  'Field No.  3  IS PASSWORD / Length -  9  / Type - A
  116. 1250  '
  117. 1260  PRINT FN CRT$( 47 , 10 );"";
  118. 1270  FL =  9 
  119. 1280  TY$ = "A"
  120. 1290  GOSUB 2370
  121. 1300  IF LEN(T$)=0 THEN  1330 
  122. 1310  IF ASC(T$)=60 THEN  1080 
  123. 1320  F$( 3 ) = T$ : REM MOVE INKEY VARIABLE TO FIELD 
  124. 1330  F$( 3 ) = F$( 3 ) + STRING$( 9 -LEN(F$( 3 )),32)
  125. 1340  PRINT FN CRT$( 47 , 10 );F$( 3 );
  126. 1350  ' Split Record into Fields
  127. 1360  R$=""
  128. 1370  R$ = R$ + F$( 1 ) + CHR$(44)
  129. 1380  R$ = R$ + F$( 2 ) + CHR$(44)
  130. 1390  R$ = R$ + F$( 3 ) + CHR$(44)
  131. 1400  ' UPdate Switch Set goto 12620
  132. 1410  IF UPDTE$="YES" THEN 1570
  133. 1420  REM
  134. 1430  '
  135. 1440  ' Write Record to File (03-24-84)
  136. 1450  '
  137. 1460  X=0:IF INT(LOF(1)/64)=0 THEN 1490
  138. 1470  X=X+1:GET 1,X:IF INSTR(KS$,D$)<>0 THEN 1520
  139. 1480  IF INT(LOF(1)/64)=X THEN 1490 ELSE 1470
  140. 1490  X=X+1:KR$="":FOR Y=1 TO A%:KR$=KR$+CHR$(94)+STRING$(KL%,32):G$=STR$(INT(LOF(1)/64)*A%+Y):KR$=KR$+STRING$(5-LEN(G$),32)+G$:NEXT Y
  141. 1500  LSET KS$=KR$: PUT 2,X
  142. 1510  LSET FR$=STRING$(RL%,0):FOR Y=1 TO A%: PUT 1, (INT(LOF(2)/64)-1)*A%+Y:NEXT Y'  Clear Master File
  143. 1520  '  Write Key
  144. 1530  '
  145. 1540  KR$=KS$
  146. 1550  P=INSTR(KR$,D$)
  147. 1560  KREC%=X
  148. 1570  '
  149. 1580  K$=CHR$(94)+K$
  150. 1590  KR$=MID$(KR$,1,P-1)+K$+MID$(KR$,P+LEN(K$),LEN(KR$))
  151. 1600  '
  152. 1610  LR%=VAL(MID$(KR$,P+LEN(K$),5))
  153. 1620  '   Write Master File
  154. 1630  LSET FR$=R$
  155. 1640  PUT 1,LR%
  156. 1650  ' Write Key
  157. 1660  LSET KS$=KR$
  158. 1670  PUT 2,KREC%
  159. 1680  GOTO  520
  160. 1690  ' String Search
  161. 1700  X=0
  162. 1710  UPDTE$="S"' Set Update Flag for Search
  163. 1720  PRINT BOTT$;BLANK$;BOTT$;"Search for ? - ";:REM .. SEARCH 
  164. 1730  FL=30' Max Length for Search String
  165. 1740  TY$="A"'Search String is Alpha
  166. 1750  GOSUB 2370
  167. 1760  Q$=T$
  168. 1770  PRINT BOTT$;BLANK$;BOTT$;"Press any key to stop search ";:FL=1:TY$="A"
  169. 1780  FOR X = 1 TO INT(LOF(1)/RL%):GET 1,X:IF INSTR(FR$,Q$)<>0  AND FR$<>STRING$(RL%,0) THEN 1810
  170. 1790  IF INKEY$ <> "" THEN 520
  171. 1800  NEXT X:GOTO  520
  172. 1810  GOSUB 2110' Print Record and Return
  173. 1820  PRINT BOTT$;BLANK$;BOTT$;"<N>ext, <S>top - ";
  174. 1830  TY$="A":FL=1:GOSUB 2370
  175. 1840  IF T$="N"  OR T$ = "n" THEN 1800
  176. 1850  IF T$="S"  OR T$="s" THEN 520
  177. 1860  GOTO  1820
  178. 1870  '
  179. 1880  REM 
  180. 1890  ' Get Record (03-24-84)
  181. 1900  REM 
  182. 1910  FL =  13 
  183. 1920  PRINT FN CRT$( 47 , 6 );STRING$(FL,46);FN CRT$( 47 , 6 );"";
  184. 1930  TY$ = "A"
  185. 1940  GOSUB 2370
  186. 1950  IF LEN(T$)=0 THEN 520:REM .RETURN  TO MAINLINE IF NULL ENTRY 
  187. 1960  K$=T$:REM . PASS INKEY TO KEY VAR.
  188. 1970  K$ = K$ + STRING$(FL-LEN(K$),32): REM . . LEFT JUST & PAD 
  189. 1980  K$ = CHR$(94) + K$
  190. 1990  REM  . . . . .  LOCATE RECORD . . . . . . .
  191. 2000  P = 0
  192. 2010  KREC% = 1 
  193. 2020  FOR  X = KREC% TO INT(LOF(1)/64): GET 2,X:IF INSTR(P+1,KS$,K$)=0 THEN P=0: NEXT X ELSE  2040
  194. 2030  PRINT BOTT$;BLANK$;BOTT$;CHR$(7)"----------->  NOT IN FILE <----------";:GOSUB 2890:GOTO 520
  195. 2040  REM . . . .  GET RECORD FROM MASTER FILE . . . .
  196. 2050  KR$=KS$
  197. 2060  KREC% = X
  198. 2070  P = INSTR(P+1,KR$,K$)
  199. 2080  LR% = VAL(MID$(KR$,P+LEN(K$),5))
  200. 2090  GET 1,LR%
  201. 2100  REM
  202. 2110  REM . . . SUBDIVIDE & PRINT RECORD . . .
  203. 2120  F$( 1 ) = MID$(FR$, 1 , 13 )
  204. 2130  F$( 2 ) = MID$(FR$, 14 , 3 )
  205. 2140  F$( 3 ) = MID$(FR$, 17 , 9 )
  206. 2150   F#( 2 ) = VAL(F$( 2 ))
  207. 2160  PRINT FN CRT$( 47 , 6 );F$( 1 );-CHR$(44)
  208. 2170   PRINT FN CRT$(  47 , 8 );F$( 2 );-CHR$(44)
  209. 2180  PRINT FN CRT$( 47 , 10 );F$( 3 );-CHR$(44)
  210. 2190  IF UPDTE$="S" THEN RETURN : REM If this is a search then return
  211. 2200  PRINT BOTT$;BLANK$;BOTT$;CHR$(7);"<C>hange, <N>ext, <D>elete  - ";
  212. 2210  FL = 1
  213. 2220  TY$ = "A"
  214. 2230  GOSUB 2370
  215. 2240  IF T$="C"  OR T$="c" THEN 900 
  216. 2250  IF T$="N" OR T$= "n"  THEN 2020 
  217. 2260  IF T$="D" OR T$="d"  THEN 2280 
  218. 2270  GOTO 520
  219. 2280  REM ... Delete Record
  220. 2290  PRINT BOTT$;BLANK$;BOTT$;"Are You Sure you want to DELETE (Y/N) ";
  221. 2300  FL=1:GOSUB 2370: IF T$="N"  OR T$="n" THEN PRINT BOTT$;BLANK$;BOTT$;CHR$(7);"--> Not      Deleted <--";:GOSUB 2890:GOTO 520
  222. 2310  IF T$<>"Y"  AND T$<>"y" THEN 2300
  223. 2320  PRINT BOTT$;BLANK$;BOTT$;"--> Deleted <--";
  224. 2330   K$=MID$(D$,2,LEN(D$))' Null Key
  225. 2340  R$=STRING$(RL%,0)' Null Master File
  226. 2350  GOTO  1570'  goto Write Record Routines
  227. 2360  '
  228. 2370  ' Keyboard Scan (Inkey) Routine
  229. 2380   COLOR 11,0
  230. 2390  LOCATE ,,1
  231. 2400  T$=""
  232. 2410  PX = POS(0): PY = CSRLIN
  233. 2420   A$=INKEY$:IF A$="" THEN  2420
  234. 2430  PRINT RB$;
  235. 2440  IF ASC(A$)=8 AND LEN(T$)>0 THEN PRINT BS$;:T$=LEFT$(T$,LEN(T$)-1):GOTO  2420
  236. 2450  IF ASC(A$)=13 THEN 2530
  237. 2460  IF ASC(A$)<32 OR ASC(A$)>127 THEN 2420
  238. 2470  T$=T$+A$
  239. 2480  '
  240. 2490  IF LEN(T$)=1 THEN  LOCATE PY,PX:PRINT STRING$(FL,".");:LOCATE PY,PX
  241. 2500  IF LEN(T$)>FL THEN T$=MID$(T$,1,LEN(T$)-1):PRINT CHR$(7);:GOTO  2420
  242. 2510  PRINT A$;
  243. 2520  GOTO  2420
  244. 2530  COLOR 7,0:LOCATE ,,0:     RETURN
  245. 2540  '              Number Validation Routine
  246. 2550  F1=0:F2=0:N=0
  247. 2560  FOR X = 1 TO LEN(T$)
  248. 2570  A=ASC(MID$(T$,X,1))
  249. 2580  IF A<45 OR A>57 THEN  PRINT CHR$(7);:GOTO  2650
  250. 2590  IF A=47 THEN      
  251. 2600  IF A=46 THEN F1=F1+1:IF F1>1 THEN PRINT CHR$(7);:GOTO  2650
  252. 2610  IF A=45 THEN F2=F2+1:IF F2>1 THEN  PRINT CHR$(7);:GOTO  2650
  253. 2620  NEXT  X
  254. 2630  IF INSTR(T$,"-")>1 THEN PRINT CHR$(7);:GOTO  2650
  255. 2640  N=1
  256. 2650  RETURN
  257. 2660  '
  258. 2670  PRINT BOTT$;BLANK$;BOTT$;"Press Enter to End Program ";:INPUT D$
  259. 2680  SYSTEM ' You may branch to another program from here this is a great
  260. 2690  REM    ' error check routine.GKG.
  261. 2700  REM
  262. 2710  REM
  263. 2720  '
  264. 2730   SOUND 450,5:SOUND 20000,1:SOUND 450,5' Error Traps
  265. 2740  IF ERR=27 OR ERR=25 THEN PRINT BOTT$;BLANK$;BOTT$;"-->Printer Not Ready<--";:GOSUB 2890:PRINT BOTT$;"<R>etry. <I>gnore, <A>bort ";:FL=1:GOSUB 2370:IF T$="A" OR T$="a" THEN RESUME 2670 ELSE IF T$="I" OR T$="i" THEN RESUME NEXT ELSE RESUME
  266. 2750  IF ERR=24 THEN PRINT BOTT$;BLANK$;BOTT$;"--> Printing <--";:RESUME
  267. 2760  E(2)=53:E$(2)="YOUR DATA FILE CANNOT BE FOUND"
  268. 2770  E(3)=54:E$(3)="BAD FILE MODE - Your DATA File does not match this Program "
  269. 2780  E(4)=57:E$(4)="DISK I/O ERROR - Cannot Recover; Try to RUN the Program again"
  270. 2790  E(5)=61:E$(5)="YOUR DISK IS FULL - Cannot Recover "
  271. 2800  E(6)=68:E$(6)="YOUR DISK IS WRITE PROTECTED "
  272. 2810  E(7)=2:E$(7)="YOU HAVE A SYNTAX ERROR IN LINE "+STR$(ERL)
  273. 2820  E(8)=11:E$(8)="You have a division by zero in Your computation at line "+STR$(ERL)
  274. 2830  FOR X = 1 TO 10:IF ERR=E(X) THEN 2850 ELSE NEXT X
  275. 2840  PRINT BOTT$;BLANK$;BOTT$;"You have error number "; ERR;" in Line Number ";ERL:GOTO  2860
  276. 2850  PRINT BOTT$;BLANK$;BOTT$;E$(X);CHR$(7)
  277. 2860  CLOSE:END
  278. 2870  RUN
  279. 2880  '
  280. 2890  '  Time Delay Loop
  281. 2900  '
  282. 2910    FOR Z = 1 TO 2200
  283. 2920    NEXT Z
  284. 2930  RETURN
  285. 2940  'GKG 03-25-84
  286.